home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / src / cmds.c < prev    next >
C/C++ Source or Header  |  1993-10-06  |  11KB  |  401 lines
  1. /* Simple built-in editing commands.
  2.    Copyright (C) 1985, 1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23. #include "commands.h"
  24. #include "buffer.h"
  25. #include "syntax.h"
  26.  
  27. #include "cmds_p.h"
  28. #include "intervals_p.h"
  29. #include "insdel_p.h"
  30. #include "dispnew_p.h"
  31.  
  32. Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
  33.  
  34. /* A possible value for a buffer's overwrite-mode variable.  */
  35. Lisp_Object Qoverwrite_mode_binary;
  36.  
  37.  
  38. DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  39.   "Move point right ARG characters (left if ARG negative).\n\
  40. On reaching end of buffer, stop and signal error.")
  41.   (n)
  42.      Lisp_Object n;
  43. {
  44.   if (NILP (n))
  45.     XFASTINT (n) = 1;
  46.   else
  47.     CHECK_NUMBER (n, 0);
  48.  
  49.   /* This used to just set point to point + XINT (n), and then check
  50.      to see if it was within boundaries.  But now that SET_PT can
  51.      potentially do a lot of stuff (calling entering and exiting
  52.      hooks, etcetera), that's not a good approach.  So we validate the
  53.      proposed position, then set point.  */
  54.   {
  55.     int new_point = point + XINT (n);
  56.  
  57.     if (new_point < BEGV)
  58.       {
  59.     SET_PT (BEGV);
  60.     Fsignal (Qbeginning_of_buffer, Qnil);
  61.       }
  62.     if (new_point > ZV)
  63.       {
  64.     SET_PT (ZV);
  65.     Fsignal (Qend_of_buffer, Qnil);
  66.       }
  67.  
  68.     SET_PT (new_point);
  69.   }
  70.  
  71.   return Qnil;
  72. }
  73.  
  74. DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  75.   "Move point left ARG characters (right if ARG negative).\n\
  76. On attempt to pass beginning or end of buffer, stop and signal error.")
  77.   (n)
  78.      Lisp_Object n;
  79. {
  80.   if (NILP (n))
  81.     XFASTINT (n) = 1;
  82.   else
  83.     CHECK_NUMBER (n, 0);
  84.  
  85.   XSETINT (n, - XINT (n));
  86.   return Fforward_char (n);
  87. }
  88.  
  89. DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  90.   "Move ARG lines forward (backward if ARG is negative).\n\
  91. Precisely, if point is on line I, move to the start of line I + ARG.\n\
  92. If there isn't room, go as far as possible (no error).\n\
  93. Returns the count of lines left to move.  If moving forward,\n\
  94. that is ARG - number of lines moved; if backward, ARG + number moved.\n\
  95. With positive ARG, a non-empty line at the end counts as one line\n\
  96.   successfully moved (for the return value).")
  97.   (n)
  98.      Lisp_Object n;
  99. {
  100.   int pos2 = point;
  101.   int pos;
  102.   int count, shortage, negp;
  103.  
  104.   if (NILP (n))
  105.     count = 1;
  106.   else
  107.     {
  108.       CHECK_NUMBER (n, 0);
  109.       count = XINT (n);
  110.     }
  111.  
  112.   negp = count <= 0;
  113.   pos = scan_buffer ('\n', pos2, count - negp, &shortage);
  114.   if (shortage > 0
  115.       && (negp
  116.       || (ZV > BEGV
  117.           && pos != pos2
  118.           && FETCH_CHAR (pos - 1) != '\n')))
  119.     shortage--;
  120.   SET_PT (pos);
  121.   return make_number (negp ? - shortage : shortage);
  122. }
  123.  
  124. DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  125.   0, 1, "p",
  126.   "Move point to beginning of current line.\n\
  127. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  128. If scan reaches end of buffer, stop there without error.")
  129.   (n)
  130.      Lisp_Object n;
  131. {
  132.   if (NILP (n))
  133.     XFASTINT (n) = 1;
  134.   else
  135.     CHECK_NUMBER (n, 0);
  136.  
  137.   Fforward_line (make_number (XINT (n) - 1));
  138.   return Qnil;
  139. }
  140.  
  141. DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  142.   0, 1, "p",
  143.   "Move point to end of current line.\n\
  144. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  145. If scan reaches end of buffer, stop there without error.")
  146.   (n)
  147.      Lisp_Object n;
  148. {
  149.   register int pos;
  150.   register int stop;
  151.  
  152.   if (NILP (n))
  153.     XFASTINT (n) = 1;
  154.   else
  155.     CHECK_NUMBER (n, 0);
  156.  
  157.   if (XINT (n) != 1)
  158.     Fforward_line (make_number (XINT (n) - 1));
  159.  
  160.   pos = point;
  161.   stop = ZV;
  162.   while (pos < stop && FETCH_CHAR (pos) != '\n') pos++;
  163.   SET_PT (pos);
  164.  
  165.   return Qnil;
  166. }
  167.  
  168. DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
  169.   "Delete the following ARG characters (previous, with negative arg).\n\
  170. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  171. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  172. ARG was explicitly specified.")
  173.   (n, killflag)
  174.      Lisp_Object n, killflag;
  175. {
  176.   CHECK_NUMBER (n, 0);
  177.  
  178.   if (NILP (killflag))
  179.     {
  180.       if (XINT (n) < 0)
  181.     {
  182.       if (point + XINT (n) < BEGV)
  183.         Fsignal (Qbeginning_of_buffer, Qnil);
  184.       else
  185.         del_range (point + XINT (n), point);
  186.     }
  187.       else
  188.     {
  189.       if (point + XINT (n) > ZV)
  190.         Fsignal (Qend_of_buffer, Qnil);
  191.       else
  192.         del_range (point, point + XINT (n));
  193.     }
  194.     }
  195.   else
  196.     {
  197.       call1 (Qkill_forward_chars, n);
  198.     }
  199.   return Qnil;
  200. }
  201.  
  202. DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  203.   1, 2, "p\nP",
  204.   "Delete the previous ARG characters (following, with negative ARG).\n\
  205. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  206. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  207. ARG was explicitly specified.")
  208.   (n, killflag)
  209.      Lisp_Object n, killflag;
  210. {
  211.   CHECK_NUMBER (n, 0);
  212.   return Fdelete_char (make_number (-XINT (n)), killflag);
  213. }
  214.  
  215. DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
  216.   "Insert the character you type.\n\
  217. Whichever character you type to run this command is inserted.")
  218.   (arg)
  219.      Lisp_Object arg;
  220. {
  221.   CHECK_NUMBER (arg, 0);
  222.  
  223.   /* Barf if the key that invoked this was not a character.  */
  224.   if (XTYPE (last_command_char) != Lisp_Int)
  225.     bitch_at_user ();
  226.   else
  227.     while (XINT (arg) > 0)
  228.       {
  229.     XFASTINT (arg)--;    /* Ok since old and new vals both nonneg */
  230.     internal_self_insert ((char)(XINT (last_command_char)),
  231.                               XFASTINT (arg) != 0);
  232.       }
  233.  
  234.   return Qnil;
  235. }
  236.  
  237. DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
  238.   "Insert a newline.  With arg, insert that many newlines.\n\
  239. In Auto Fill mode, if no numeric arg, break the preceding line if it's long.")
  240.   (arg1)
  241.      Lisp_Object arg1;
  242. {
  243.   int flag;
  244.   Lisp_Object arg;
  245.   char c1 = '\n';
  246.  
  247.   arg = Fprefix_numeric_value (arg1);
  248.  
  249.   if (!NILP (current_buffer->read_only))
  250.     Fbarf_if_buffer_read_only ();
  251.  
  252.   /* Inserting a newline at the end of a line produces better
  253.      redisplay in try_window_id than inserting at the beginning of a
  254.      line, and the textual result is the same.  So, if we're at
  255.      beginning of line, pretend to be at the end of the previous line.  
  256.  
  257.      We can't use internal_self_insert in that case since it won't do
  258.      the insertion correctly.  Luckily, internal_self_insert's special
  259.      features all do nothing in that case.  */
  260.  
  261.   flag = point > BEGV && FETCH_CHAR (point - 1) == '\n';
  262.   if (flag)
  263.     SET_PT (point - 1);
  264.  
  265.   while (XINT (arg) > 0)
  266.     {
  267.       if (flag)
  268.     insert (&c1, 1);
  269.       else
  270.     internal_self_insert ('\n', !NILP (arg1));
  271.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  272.     }
  273.  
  274.   if (flag)
  275.     SET_PT (point + 1);
  276.  
  277.   return Qnil;
  278. }
  279.  
  280. /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
  281.    even if it is enabled.
  282.  
  283.    If this insertion is suitable for direct output (completely simple),
  284.    return 0.  A value of 1 indicates this *might* not have been simple.  */
  285.  
  286. int
  287. internal_self_insert (c1, noautofill)
  288.      char c1;
  289.      int noautofill;
  290. {
  291.   extern Lisp_Object Fexpand_abbrev ();
  292.   int hairy = 0;
  293.   register enum syntaxcode synt;
  294.   register int c = c1;
  295.   Lisp_Object overwrite = current_buffer->overwrite_mode;
  296.  
  297.   if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function))
  298.     hairy = 1;
  299.  
  300.   if (!NILP (overwrite)
  301.       && point < ZV
  302.       && (EQ (overwrite, Qoverwrite_mode_binary)
  303.       || (c != '\n' && FETCH_CHAR (point) != '\n'))
  304.       && (EQ (overwrite, Qoverwrite_mode_binary)
  305.       || FETCH_CHAR (point) != '\t'
  306.       || XINT (current_buffer->tab_width) <= 0
  307.       || XFASTINT (current_buffer->tab_width) > 20
  308.       || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
  309.     {
  310.       del_range (point, point + 1);
  311.       hairy = 1;
  312.     }
  313.   if (!NILP (current_buffer->abbrev_mode)
  314.       && SYNTAX (c) != Sword
  315.       && NILP (current_buffer->read_only)
  316.       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
  317.     {
  318.       int modiff = MODIFF;
  319.       Fexpand_abbrev ();
  320.       /* We can't trust the value of Fexpand_abbrev,
  321.      but if Fexpand_abbrev changed the buffer,
  322.      assume it expanded something.  */
  323.       if (MODIFF != modiff)
  324.     hairy = 1;
  325.     }
  326.   if ((c == ' ' || c == '\n')
  327.       && !noautofill
  328.       && !NILP (current_buffer->auto_fill_function)
  329.       && current_column () > XFASTINT (current_buffer->fill_column))
  330.     {
  331.       if (c1 != '\n')
  332.     insert (&c1, 1);
  333.       call0 (current_buffer->auto_fill_function);
  334.       if (c1 == '\n')
  335.     insert (&c1, 1);
  336.       hairy = 1;
  337.     }
  338.   else
  339.     insert (&c1, 1);
  340.   synt = SYNTAX (c);
  341.   if ((synt == Sclose || synt == Smath)
  342.       && !NILP (Vblink_paren_function) && INTERACTIVE)
  343.     {
  344.       call0 (Vblink_paren_function);
  345.       hairy = 1;
  346.     }
  347.   return hairy;
  348. }
  349.  
  350. /* module initialization */
  351.  
  352. _VOID_
  353. syms_of_cmds ()
  354. {
  355.   Qkill_backward_chars = intern ("kill-backward-chars");
  356.   staticpro (&Qkill_backward_chars);
  357.  
  358.   Qkill_forward_chars = intern ("kill-forward-chars");
  359.   staticpro (&Qkill_forward_chars);
  360.  
  361.   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
  362.   staticpro (&Qoverwrite_mode_binary);
  363.  
  364.   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
  365.     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
  366. More precisely, a char with closeparen syntax is self-inserted.");
  367.   Vblink_paren_function = Qnil;
  368.  
  369.   defsubr (&Sforward_char);
  370.   defsubr (&Sbackward_char);
  371.   defsubr (&Sforward_line);
  372.   defsubr (&Sbeginning_of_line);
  373.   defsubr (&Send_of_line);
  374.  
  375.   defsubr (&Sdelete_char);
  376.   defsubr (&Sdelete_backward_char);
  377.  
  378.   defsubr (&Sself_insert_command);
  379.   defsubr (&Snewline);
  380. }
  381.  
  382. _VOID_
  383. keys_of_cmds ()
  384. {
  385.   int n;
  386.  
  387.   initial_define_key (global_map, Ctl('M'), "newline");
  388.   initial_define_key (global_map, Ctl('I'), "self-insert-command");
  389.   for (n = 040; n < 0177; n++)
  390.     initial_define_key (global_map, n, "self-insert-command");
  391.   for (n = 0240; n < 0377; n++)
  392.     initial_define_key (global_map, n, "self-insert-command");
  393.  
  394.   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
  395.   initial_define_key (global_map, Ctl ('B'), "backward-char");
  396.   initial_define_key (global_map, Ctl ('D'), "delete-char");
  397.   initial_define_key (global_map, Ctl ('E'), "end-of-line");
  398.   initial_define_key (global_map, Ctl ('F'), "forward-char");
  399.   initial_define_key (global_map, 0177, "delete-backward-char");
  400. }
  401.